gusucode.com > 耐品图片管理系统 标准版A > 耐品图片管理系统 标准版A/Inc/clsImage.asp

    <%
'===============================================================
' 著作权号：中国国家版权局著作权登记号2004SR07385
' 版权所有：深圳市耐品科技开发有限公司 www.naipin.com
' 联系电话：0755-26611119　81234844　81234845
' 联系手机：13316911914
' 联系邮箱：naipin@naipin.com
'===============================================================

' ===========Image Operation Class=============
' FileName: clsImage.asp
' DateTime: 2006-05-18
' Copyright (C) 2006-2007 www.naipin.com
' Script Written By Lyout
'==============================================

Class Lyout_Image
	Dim objJpeg				' AspJpeg 对象
	Dim objFso				' 文件读写对象
	Dim intImageWidth		' 图像宽度
	Dim intImageHeight		' 图像高度
	Dim strMessage			' 当作操作信息
	Dim flagOpen			' 文件打开标志
	Dim intJpegWidth		' 水印区域宽度
	Dim intJpegHeight		' 水印区域高度
	Dim intJpegColor		' 水印文字颜色或水印图片透明色
	Dim strJpegFamily		' 水印文字字体
	Dim flagJpegBold		' 水印文字是否粗体
	Dim intJpegSize			' 水印文字大小
	Dim floatJpegOpacity	' 水印图片透明度
	
	Public Property Get Width()
		Width = intImageWidth
	End Property
	
	Public Property Get Height()
		Height = intImageHeight
	End Property
	
	Public Property Let Message(ByVal strMsg)
		strMessage = strMsg
	End Property
	
	Public Property Get Message()
		Message = strMessage
	End Property
	
	Public Property Get FileIsOpen()
		FileIsOpen = flagOpen
	End Property
	
	Public property Let JpegWidth(ByVal intWidth)
		intJpegWidth = intWidth
	End Property
	
	Public property Let JpegHeight(ByVal intHeight)
		intJpegHeight = intHeight
	End Property
	
	Public Property Let JpegColor(ByVal intColor)
		intJpegColor = intColor
	End Property
	
	Public Property Let JpegFamily(ByVal strFamily)
		strJpegFamily = strFamily
	End Property
	
	Public Property Let JpegBold(ByVal flagBold)
		flagJpegBold = CBool(flagBold)
	End Property
	
	Public Property Let JpegSize(ByVal intSize)
		intJpegSize = intSize
	End Property
	
	Public Property Let JpegOpacity(ByVal floatOpacity)
		floatJpegOpacity = floatOpacity
	End Property
	
	Private Sub Class_Initialize
		On Error Resume Next
		
		intImageWidth = 0
		intImageHeight = 0
		strMessage = ""
		flagOpen = False
		intJpegColor = &HFFFFFF
		strJpegFamily = "Arial"
		flagJpegBold = True
		intJpegSize = 20
		floatJpegOpacity = 1
		
		intJpegWidth = 0
		intJpegHeight = 0
		
		Set objJpeg = Server.CreateObject("Persits.Jpeg")
		If Err Then
			Set objJpeg = Nothing
			Message = "组件 Persits.Jpeg 没有安装！"
			Exit sub
		End If
		
		Message = ""
		Set objFso = Server.CreateObject("Scripting.FileSystemObject")
		If Err Then
			Set objFso = Nothing
			Message = "组件 Scripting.FileSystemObject 没有安装！"
			Exit Sub
		End If
	End Sub
	
	' 打开文件 strFileName
	Public Function Open(strFileName)
		Open = False
		Message = ""
		If Not FileIsOpen Then
			On Error Resume Next
			If objFso.FileExists(Server.MapPath(strFileName)) Then
				objJpeg.Open Server.MapPath(strFileName)
				If Err Then
					Message = Err.Description&"<br>"
					Exit Function
				End If
				intImageWidth = objJpeg.OriginalWidth
				intImageHeight = objJpeg.OriginalHeight
				Open = True
				flagOpen = True
				Message = "文件打开成功！"
			Else
				Message = "文件不存在！"
			End If
		Else
			Message = "文件已打开！"
		End If
	End Function
	
	' 保存到文件 destFile
	Public Sub SaveAs(destFile)
		Message = ""
		On Error Resume Next
		If FileIsOpen Then
			objJpeg.Save Server.MapPath(destFile)
			If Err Then
				Message = Err.Description
			End If
		Else
			Message = "文件已经保存！"
		End If
	End Sub
	
	' 关闭对象
	Public Sub Close()
		On Error Resume Next
		If FileIsOpen Then
			objJpeg.Close
			flagOpen = False
		End If
	End Sub
	
	' 缩放到宽度为 intWidth,高度为 intHeight
	Public Sub ResizeTo(intWidth,intHeight)
		Dim destWidth
		Dim destHeight
		Dim m
		Dim n
		
		Message = ""
		If FileIsOpen Then
			With objJpeg
				m = intImageWidth/intWidth
				n = intImageHeight/intHeight
				
				If intImageWidth>intWidth Or intImageHeight>intHeight Then
					If m>n Then
						destWidth = intWidth
						destHeight = intImageHeight/m
					ElseIf m<n Then
						destHeight = intHeight
						destWidth = intImageWidth/n
					Else
						destWidth = intWidth
						destHeight = intHeight
					End If
				Else
					destWidth = intImageWidth
					destHeight = intImageHeight
				End If
				.Width = destWidth
				.Height = destHeight
			End With
			intImageWidth = destWidth
			intImageHeight = destHeight
		Else
			Message = "文件没有打开！"
		End If
	End Sub
	
	' 水印文字
	' intDirection:图片位置:
	'	如果传进来的是数组 Array(left,top)：
	'		left 表示水印图片相对源图的左上角X方向距离
	'		top 表示水印图片相对源图的左上角Y方向距离
	'	如果是单一数字：
	'		1:左上	2:上中	3:右上	4:左中	5:中中	6:右中	7:左下	8:中下	9:右下
	' intLeft 表示水印文字相对源图的左上角X方向距离
	' intTop 表示水印文字相对源图的左上角Y方向距离
	' strText 水印文字
	Public Sub DrawText(intDirection,strText)
		Dim objJpeg2
		Dim intWidth
		Dim intHeight
		Dim intLeft
		Dim intTop
		
		Message = ""
		If FileIsOpen Then
			intWidth = intJpegWidth
			intHeight = intJpegHeight
			If intWidth<Width And intHeight<Height Then
				If Not IsArray(intDirection) Then
					Select Case intDirection
					Case 1
						intLeft = 0
						intTop	= 0
					Case 2
						intLeft = (Width-intWidth)/2
						intTop	= 0
					Case 3
						intLeft = Width-intWidth
						intTop	= 0
					Case 4
						intLeft = 0
						intTop  = (Height-intHeight)/2
					Case 5
						intLeft = (Width-intWidth)/2
						intTop	= (Height-intHeight)/2
					Case 6
						intLeft = Width-intWidth
						intTop  = (Height-intHeight)/2
					Case 7
						intLeft = 0
						intTop  = Height-intHeight
					Case 8
						intLeft = (Width-intWidth)/2
						intTop  = Height-intHeight
					Case Else
						intLeft = Width-intWidth
						intTop  = Height-intHeight
					End Select
				Else
					intLeft = intDirection(0)
					intTop	= intDirection(1)
				End If
				On Error Resume Next
				With objJpeg.Canvas
					.Font.Color	 = intJpegColor
					.Font.Family = strJpegFamily
					.Font.Bold   = flagJpegBold
					.Font.Size   = intJpegSize*2
					.Print intLeft,intTop,strText
				End With
				If Err Then
					Message = "打文字水印出错！"
				End If
			Else
				Message = "图片太小或水印区域过大！"
			End If
		Else
			Message = "文件没有打开！"
		End If
	End Sub
	
	' 图片水印
	' intDirection:图片位置:
	'	如果传进来的是数组 Array(left,top)：
	'		left 表示水印图片相对源图的左上角X方向距离
	'		top 表示水印图片相对源图的左上角Y方向距离
	'	如果是单一数字：
	'		1:左上	2:上中	3:右上	4:左中	5:中中	6:右中	7:左下	8:中下	9:右下
	' strFileName:用做水印图片的文件名
	Public Sub DrawImage(intDirection,strFileName)
		Dim objJpeg2
		Dim intWidth
		Dim intHeight
		Dim intLeft
		Dim intTop
		
		Message = ""
		If FileIsOpen Then
			If objFso.FileExists(Server.MapPath(strFileName)) Then
				On Error Resume Next
				Set objJpeg2 = Server.CreateObject("Persits.Jpeg")
				With objJpeg2
					.Open Server.MapPath(strFileName)
					If Err Then
						Message = Err.Description
					End If
					If intJpegWidth = 0 Or intJpegHeight = 0 Then
						intWidth = .OriginalWidth
						intHeight = .OriginalHeight
					Else
						intWidth = intJpegWidth
						intHeight = intJpegHeight
					End If
					If intWidth<Width And intHeight<Height Then
						If Not IsArray(intDirection) Then
							Select Case intDirection
							Case 1
								intLeft = 0
								intTop	= 0
							Case 2
								intLeft = (Width-intWidth)/2
								intTop	= 0
							Case 3
								intLeft = Width-intWidth
								intTop	= 0
							Case 4
								intLeft = 0
								intTop  = (Height-intHeight)/2
							Case 5
								intLeft = (Width-intWidth)/2
								intTop	= (Height-intHeight)/2
							Case 6
								intLeft = Width-intWidth
								intTop  = (Height-intHeight)/2
							Case 7
								intLeft = 0
								intTop  = Height-intHeight
							Case 8
								intLeft = (Width-intWidth)/2
								intTop  = Height-intHeight
							Case Else
								intLeft = Width-intWidth
								intTop  = Height-intHeight
							End Select
						Else
							intLeft = intDirection(0)
							intTop	= intDirection(1)
						End If
						On Error Resume Next
						objJpeg.DrawImage intLeft,intTop,objJpeg2,floatJpegOpacity,intJpegColor
						If Err Then
							Message = "打图片水印出错！"
						End If
					Else
						Message = "水印图片像素过大！"
					End If
				End With
			Else
				Message = "水印图片不存在！"
			End If
		Else
			Message = "文件没有打开！"
		End If
	End Sub
	
	Public Sub DrawCanvas(strFileName,strManuName)
		Dim objImageBar,objImageLogo,TextWidth
		
		Message = ""
		If FileIsOpen Then
			Set objImageBar = Server.CreateObject("Persits.Jpeg")
			Set objImageLogo = Server.CreateObject("Persits.Jpeg")
			
			objImageLogo.Open Server.MapPath(strFileName)
			
			With objJpeg
				objImageBar.New intImageWidth,20,&HFFFFFF
				objImageBar.Canvas.Pen.Color = &HFFFFFF
				objImageBar.Canvas.Pen.Width = 40
				'objImageBar.Canvas.Brush.Solid = False
				objImageBar.Canvas.DrawBar 0,0,intImageWidth,intImageHeight
				
				.Canvas.Font.Color = &HCCCCCC
				.Canvas.Font.Family = "宋体"
				.Canvas.Font.Bold = 0
				.Canvas.Font.Size = 12
				TextWidth = .Canvas.GetTextExtent("图片署名："&strManuName)
				
				.DrawImage 0,intImageHeight-20,objImageBar,1,&H000000
				.DrawImage 0,intImageHeight-20,objImageLogo,1,&H000000
				.Canvas.Print intImageWidth-10-TextWidth,intImageHeight-3-12,"图片署名："&strManuName
				.Quality = 90
			End With
			
			objImageLogo.Close
			Set objImageLogo = Nothing
			Set objImageBar = Nothing
		Else
			Message = "文件没有打开！"
		End If
	End Sub
	
	' 从坐标 (x0,y0) 到 (x1,y1) 截剪图片
	Public Sub Crop(x0,y0,x1,y1)
		Message = ""
		If FileIsOpen Then
			objJpeg.Crop x0,y0,x1,y1
		Else
			Message = "文件没有打开！"
		End If
	End Sub
	
	Private Sub Class_Terminate
		On Error Resume Next
		If Not objJpeg Is Nothing Then
			If IsObject(objJpeg) Then objJpeg.Close
			Set objJpeg = Nothing
		End If
		Set objFso = Nothing
	End	Sub
End Class
%>